        TITL DAI FIRMWARE 0E92D-0EA3F  V1.0  Rev.1
        ORG   :E92D
*
*
*
*************************
* LENGTH OF BLOCK IN BC *
*************************
*
* Part of Run 'CLEAR' (D214).
*
MPT45   CALL  :DE1A     Calc. length of block
        MOV   B,H       )
        MOV   C,L       ) Length in BC
        RET
*
**********************
* EVALUATE A COMPARE *
**********************
*
* Decodes flags and opcode to a truthtable.
* Following a XFCOMP or a XICOMP by a jump to
* E933 leaves FF (true) or 00 (false) in A as
* result.
*
* Entry: E: Opcode.
*        F: Flags.
* Exit:  BCDEF preserved, HL corrupted.
*        A: Truth value.
*
ROREL   PUSH  PSW       Save flags
        MOV   A,E       )
        ANI   :0F       ) Calc offset
        ADD   A         )
        ADD   A         )
        LXI   H,:E943   Base addr
        CALL  :DE30     Add offset to base
        POP   PSW       Restore flags
        MVI   A,:FF     Init truth value
        PCHL            Goto routine
*
ROGEQ   RP              FF if MACC >= M
        JMP   :E958     (S=0)
*
ROGT    JM    :E958     FF if MACC > M
        NOP             (S=0 and Z=0)
*
RONEQ   RNZ             FF if MACC <> M
        JMP   :E958     (Z=0)
*
ROLEQ   RZ              FF if MACC <= M
        NOP             (S=1 or Z=1)
        NOP
        NOP
*
ROLT    RM              FF if MACC < M
        JMP   :E958     (S=1)
*
ROEQ    RZ              FF if MACC = M
 REM (Z=1)
*
RFALSE  CMA             00 if condition false
        RET
*
****************************
* RUN A VARIABLE REFERENCE *
****************************
*
* Produces a pointer to the value of a variable.
* The variable may be simple or subscripted and
* of any type. If subscripted, subscripts are
* evaluated and checked for range.
*
* Entry: BC: Points to encoded variable.
*        D:  0 if MACC free.
* Exit:  BC updated, DE preserved, F corrupted.
*        HL: Points to variable storage.
*        A:  Type of variable from symbol table.
*
RARRN   PUSH  D
        XRA   A         Array name only
*
RVREN   MVI   D,:00
        JMP   :D73D     Run varptr
*
        DATA  :FF
        DATA  :FF
*
*************************************
* RUN VARPTR (ARRAY WITH ARGUMENTS) *
*************************************
*
* Runs a varptr with A=FF, D=0.
*
* Exit: BC updated, DE preserved, MACC corrupted.
*       HL: Varptr.
*       A:  T/L byte.
*
RVAR    PUSH  D
        MVI   A,:FF     Set mask for arrays (not
 REM name only)
        JMP   :E95C     Run varptr
*
        DATA  :FF
        DATA  :FF
*
**************************
* RUN A VARIABLE POINTER *
**************************
*
* RVARE: Entry for arrays.
* RVR05: 'Normal' entry.
*
* Entry: BC: Points to var.reference in program.
*        A:  Mask.
*        D:  0 if MACC free.
* Exit:  HL: Varptr (for strings: stringpntr).
*        A:  T/L of symtab.
*        BC updated, DE preserved.
*
RVARE   MVI   A,:FF     Not array name only
RVR05   PUSH  PSW
        PUSH  D
        LDAX  B         )
        INX   B         )
        ANI   :3F       ) Get offset in symtab
        MOV   D,A       ) in DE
        LDAX  B         )
        INX   B         )
        MOV   E,A       )
        LHLD  :02A1     Get start symtab
        DAD   D         HL pnts to actual addr
 REM in symtab
        POP   D
        POP   PSW       Restore mask
        ANA   M         And with T/L byte
        ANI   :40       Bit 6 only
        MOV   A,M
        INX   H
        RZ              Abort if simple variable or
 REM array name only
 REM
* Compute actual position in array:
 REM
        DCR   D
        INR   D         Check D=0: MACC free
        CNZ   :C018     Save MACC on stack if not
        PUSH  D
        PUSH  PSW
        MOV   E,M       ) Get pntr from symtab
        INX   H         ) in DE
        MOV   D,M       )
        INX   H
        MOV   A,D       ) Check if undimensioned
        ORA   E         )
ERRUA   MVI   A,:0F     Then run error
        JZ    :D9F5     'UNDEFINED ARRAY'
        PUSH  D
        LXI   H,:0000   Init index
        XTHL            Pntr to array in HL
        LDAX  B         Get nr of subscripts
        INX   B
        MOV   D,A       in D
        CMP   M         Comp. with nr of dimensions
        INX   H
        JNZ   :DA29     Run 'SUBSCRIPT ERROR' if
 REM not identical
RVR10   CALL  :E74F     Get variable type in A
RVR15   CMP   M
        JC    :E9B1     If value in A is offset
        JZ    :E9B1
        MVI   A,:05     If subscript <0 or >FF:
        JMP   :D9F5     Run 'SUBSCRIPT ERROR'
 REM
* Calc reference to Nth array element
* via (a1*(d2+1)+a2*(d3+1)+..+aN). aN
* is argument, dN is dimension:
 REM
RVR20   XTHL            Restore HL=00
        CALL  :DE30     Add offset to index
        DCR   D         decr nr of arguments
        XTHL
        INX   H
        JZ    :E9C5     If no more subscipts
        MOV   A,M       Next dimension
        INR   A
        XTHL
        CALL  :DE8F     Multiply index by it
        XTHL
        JMP   :E9A2     Process next subscript
*
RVR30   XCHG
        POP   H         Get index to array from
 REM symtab
        POP   PSW       Get type byte
        PUSH  PSW
        ANI   :30       Bits 5,6 only
        CPI   :20
        DAD   H         Add offset to element
        JZ    :E9D2
        DAD   H
RVR40   DAD   D         Abs addr of element in HL
 REM (STR: pntr to string)
        POP   PSW
        POP   D
        CNZ   :C01B     Evt retrieve MACC from stack
        RET
*
****************************
* EVALUATE A FUNCTION CALL *
****************************
*
* Finds address of function routine in
* indirection table (#E9F0) and performs the
* function routine.
*
* Entry: BC: Points to function label (#20)
*            in program line.
* Exit:  MACC: Numeric result.
*        BC updated, AFDEHL corrupted.
*
RFUN    INX   B         Pnts past label
        LDAX  B         Get function code
        INX   B
        MOV   L,A       Code in HL
        MVI   H,:00
        LXI   D,:E9F0   Get startaddr. table
        DAD   H         Code *2
        DAD   D         Add offset to startaddr
        MOV   E,M       lobyte addr in E
        INX   H
        MOV   A,M       hibyte addr in A
        ORI   :80       Set msb = 1
        MOV   D,A       hibyte in D
        CMP   M         Was it already E...?
        PUSH  D         Addr function on stack
        CZ    :E808     Then evaluate 1st num
 REM expr, result in MACC
        RET             Go to function routine
*
******************************
* FUNCTION INDIRECTION TABLE *
******************************
*
* Startaddress table is E9F0. The function code
* is given between brackets.
* If the msb of the address is set, the first
* argument is a numeric one.
*
* In the textbuffer, the Basic fuctions are
* indicated by 20 xx, (xx is function code).
*
FUNIT   DBL   :EA50     (00)  ABS
        DBL   :EA53     (01)  ALOG
        DBL   :6ACB     (02)  ASC
        DBL   :6AD2     (03)  CHR$
        DBL   :6AB8     (04)  CURY
        DBL   :6ABE     (05)  CURX
        DBL   :EA56     (06)  EXP
        DBL   :EA59     (07)  FRAC
        DBL   :6B43     (08)  FRE
        DBL   :EB5C     (09)  FREQ
        DBL   :6B79     (0A)  GETC
        DBL   :6A83     (0B)  HEX$
        DBL   :6B82     (0C)  INP
        DBL   :EB8D     (0D)  INT
        DBL   :6AE2     (0E)  LEFT$
        DBL   :6AC4     (0F)  LEN
        DBL   :6BA1     (10)  VARPTR
        DBL   :EA5C     (11)  LOG
        DBL   :EA5F     (12)  LOGT
        DBL   :6BA7     (13)  XMAX
        DBL   :6BAE     (14)  YMAX
        DBL   :6B0E     (15)  MID$
        DBL   :6BC1     (16)  PDL
        DBL   :6C16     (17)  PEEK
        DBL   :6C1D     (18)  PI
        DBL   :6AFF     (19)  RIGHT$
        DBL   :EC27     (1A)  RND
        DBL   :6C9D     (1B)  SCRN
        DBL   :EC7B     (1C)  SGN
        DBL   :6A8C     (1D)  SPC
        DBL   :EA62     (1E)  SQR
        DBL   :EA77     (1F)  STR$
        DBL   :6AA2     (20)  TAB
        DBL   :6B25     (21)  VAL
        DBL   :EA65     (22)  SIN
        DBL   :EA68     (23)  COS
        DBL   :EA6B     (24)  TAN
        DBL   :EA6E     (25)  ASIN
        DBL   :EA71     (26)  ACOS
        DBL   :EA74     (27)  ATN
*
*
*
        END
